home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / System / SYMBOL / Symbol Processors / Transform / gen-transpose-scroll next >
Lisp/Scheme  |  1998-10-23  |  2KB  |  55 lines
  1. gen-transpose-scroll symbol-pattern repeat transpose-pattern scroll
  2.  
  3. This function is lets you process small symbol-pattern with scrolling and transposing. It is a sort of gen-morph. The input symbol-pattern is first scrolled by the amount of scroll. If it is 0 no scrolling will take place. Next the scrolled result is transposed by the amount of first value in transpose-pattern. It is appended to the output repeat number of times. Then the next transpose-pattern value is used and scroll is increased by its value. If you have scroll value 2 then next time the symbol-pattern is scrolled by 4 before transposing, and so on. 
  4.  
  5. (gen-transpose-scroll '(a b c d) 2 '(0 1 2 3) 1)
  6. --> (a b c d a b c d e b c d e b c d e f c d e f c d e f g d e f g d)
  7.  
  8. Here's more useful example what you might do. Let's first build a pattern of length 8 based on resynthesis of white noise.
  9.  
  10. (setq seedpat1 
  11.   (vector-to-symbol a h 
  12.      (vector-quantize 7 8 
  13.         (vector-resynthesize 3 
  14.            (gen-noise-white 256 1 0.21215454) nil t))))
  15. --> (h c f g a f g f)
  16.  
  17. Then make another pattern by taking inversion of it.
  18.  
  19. (setq seedpat2 (symbol-inversion 'e seedpat1))
  20. --> (b g d c i d c d)
  21.  
  22. Now make transpose patterns picking up randomly some values from
  23. a given transpose pattern list.
  24.  
  25. (setq transpat (gen-random 0.2252 11 '(0 0  0 0  0 0  5 5  4 4 4)))
  26. --> (0 0 0 0 0 5 0 4 4 4 0)
  27.  
  28. (setq transpat2 (gen-random 0.322252 11 '(0 0  0 0  0 0  5 5  4 4 4)))
  29. --> (4 5 4 0 4 4 0 0 5 4 0)
  30.  
  31. Then generate two melodies. Let the first one scroll patterns. Use symbol-fold in both to keep the process withing 14 symbols.
  32.  
  33. (setq melody-1 
  34.    (symbol-fold 14 7 (gen-transpose-scroll seedpat1 2 transpat -1)))
  35.  
  36. (setq melody-2 
  37.    (symbol-fold 14 7 (gen-transpose-scroll seedpat2 2 transpat2 0)))
  38.  
  39. --> long patterns, check in visualizer
  40.  
  41. As an example how you could write more such functions the source code is included here.
  42.  
  43. (defun gen-transpose-scroll (mel repeat trpat sign)
  44.   (let ((out nil)
  45.         (master-tr trpat)
  46.         (trval nil))
  47.     (dotimes (i (length trpat))
  48.       (setq trval (car master-tr))
  49.       (setq master-tr (cdr master-tr))
  50.       (if (null master-tr) (setq master-tr trpat))
  51.       (dotimes (j repeat)
  52.         (push (symbol-transpose trval (symbol-scroll (* sign i) mel)) out)))
  53.     (flatten (nreverse out))))
  54.  
  55.